COMMENT ⊗   VALID 00020 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	ENTRY GDDINI,GDPYUP,GSCREN,GSCREM,GDRKEN,GLITEN,GINVEN,GDOT,GLINE,GRECTA,GELLIP,
C00006 00003	INTERNAL INTEGER PROCEDURE GGDDCH(INTEGER CHAN)
C00007 00004	INTERNAL PROCEDURE GERASE(INTEGER CHAN)
C00008 00005	INTERNAL PROCEDURE GDDINI
C00009 00006	INTERNAL PROCEDURE GDPYUP(INTEGER CHAN, DDBUFFER(-1))
C00010 00007	INTERNAL PROCEDURE GSCREN(REAL XLO,YLO,XHI,YHI)
C00011 00008	INTERNAL PROCEDURE GSCREM(REFERENCE REAL XLO,YLO,XHI,YHI)
C00012 00009	INTERNAL PROCEDURE GDRKEN
C00013 00010	INTERNAL PROCEDURE GLITEN
C00014 00011	INTERNAL PROCEDURE GINVEN
C00015 00012	INTERNAL PROCEDURE GDOT(REAL X,Y INTEGER THK(0))
C00016 00013	INTERNAL PROCEDURE GLINE(REAL X1,Y1,X2,Y2 INTEGER THK(0))
C00018 00014	INTERNAL PROCEDURE GRECTA(REAL X1,Y1,X2,Y2)
C00020 00015	INTERNAL PROCEDURE GELLIP(REAL X1,Y1,X2,Y2)
C00022 00016	INTERNAL PROCEDURE GPOLY(INTEGER N REFERENCE REAL X,Y)
C00023 00017	INTERNAL PROCEDURE GPOLYX(INTEGER N REFERENCE REAL X,Y)
C00024 00018	INTERNAL PROCEDURE GTXTPS(REAL X,Y,XS,YS,DXS(0),DYS(0))
C00025 00019	INTERNAL PROCEDURE GTEXT(STRING TXT)
C00026 00020	INTERNAL PROCEDURE GTEXTD(STRING TXT)
C00027 ENDMK
C⊗;
ENTRY GDDINI,GDPYUP,GSCREN,GSCREM,GDRKEN,GLITEN,GINVEN,GDOT,GLINE,GRECTA,GELLIP,
GPOLY,GPOLYX,GTXTPS,GTEXT,GTEXTD,GERASE,GGDDCH;

BEGIN "DDSIM"
COMMENT Simulate HPM's routines on the Grinnell.;


REQUIRE "GFNHDR.SAI[HDR,HE]"  SOURCE_FILE;
REQUIRE "GRNHDR.SAI[HDR,HE]" SOURCE_FILE;
REQUIRE "GRFHDR.SAI[HDR,HE]" SOURCE_FILE;
REQUIRE "GRNDEF[HDR,HE]" SOURCE_FILE;
INTEGER FIRSTIME;		COMMENT This must be set to zero initially.;
INTEGER WRITEMODE;		COMMENT What state the Grinnell is in. (LWM);
INTEGER IERRFG,TERRFG,SERRFG;	COMMENT Whether or not the user has committed a sin;
REAL XL,XH,YL,YH;		COMMENT The user's virtual screen.;
INTEGER XPOS, YPOS;		COMMENT Pixel position where txt will be started;

COMMENT Routines to convert from user coordinates to pixels.;
INTEGER PROCEDURE XPIX(REAL X);
RETURN((X-XL)/(XH-XL)*511 + 0.5);

INTEGER PROCEDURE YPIX(REAL Y);
RETURN((Y-YL)/(YH-YL)*479 + 0.5);  comment hardware changed...can't see top band;

COMMENT Procedures used in clipping;
DEFINE XLIMIT(VAL)="IF VAL < 0 THEN VAL←0 ELSE IF VAL > 511 THEN VAL←511";
DEFINE YLIMIT(VAL)="IF VAL < 0 THEN VAL←0 ELSE IF VAL > 479 THEN VAL←479";
DEFINE XOUT(VAL) = "((VAL<0) OR (VAL>511))";
DEFINE YOUT(VAL) = "((VAL<0) OR (VAL>479))";


COMMENT Procedure to convert letters to uppercase;
SIMPLE INTEGER PROCEDURE UPPERCASE(INTEGER I);
   RETURN(IF I>'140 ∧ I≤'172 THEN I LAND '137 ELSE I);
INTERNAL INTEGER PROCEDURE GGDDCH(INTEGER CHAN);
BEGIN "GGDDCH"
COMMENT Don't really get a DD channel, just return the Grinnell one.;
	RETURN('43)
END "GGDDCH";
INTERNAL PROCEDURE GERASE(INTEGER CHAN);
BEGIN "GERASE"
COMMENT If they try to "erase" the Grinnell channel, use an ERS.;
	IF CHAN = '43 THEN GRNINS(ERS)
END "GERASE";
INTERNAL PROCEDURE GDDINI;
BEGIN "GDDINI"
COMMENT Set up the Grinnell in single-user mode.;
	COMMENT This little hack allows multiple calls to DDINIT but it assumes
		that FIRSTIME is set to zero by the loader.;
	IF FIRSTIME=0 THEN
	    BEGIN
		GRNINI;
		FIRSTIME ← 1
	    END;
	GRNINS(LDC LOR 1);
	GRNINS(LSM LOR '377);	COMMENT All eight bits;
	comment Put code here to set up intensity map.;
	IERRFG ← TRUE;
	TERRFG ← TRUE;
	SERRFG ← TRUE;
	WRITEMODE ← 0;
	GRNINS(LWM LOR WRITEMODE);
	COMMENT Erase the screen;
	GRNINS(ERS);
END "GDDINI";

INTERNAL PROCEDURE GDPYUP(INTEGER CHAN, DDBUFFER(-1));
BEGIN "GDPYUP"
BUFOUT
END "GDPYUP";
INTERNAL PROCEDURE GSCREN(REAL XLO,YLO,XHI,YHI);
BEGIN "GSCREN"
COMMENT Set up screen parameters.;
XL ← XLO;
YL ← YLO;
XH ← XHI;
YH ← YHI
END "GSCREN";

INTERNAL PROCEDURE GSCREM(REFERENCE REAL XLO,YLO,XHI,YHI);
BEGIN "GSCREM"
COMMENT Return screen parameters.;
XLO ← XL;
YLO ← YL;
XHI ← XH;
YHI ← YH
END "GSCREM";

INTERNAL PROCEDURE GDRKEN;
BEGIN "GDRKEN"
COMMENT Set up inverted background write mode.;
WRITEMODE ← WRITEMODE LOR BITB;
GRNINS(LWM LOR WRITEMODE)
END "GDRKEN";

INTERNAL PROCEDURE GLITEN;
BEGIN "GLITEN"
COMMENT Set up non-inverted background write mode.;
WRITEMODE ← WRITEMODE LAND (LNOT BITB);
GRNINS(LWM LOR WRITEMODE)
END "GLITEN";

INTERNAL PROCEDURE GINVEN;
BEGIN "GINVEN"
COMMENT There's no hardware to do this...just cop out.;
IF IERRFG THEN
    BEGIN
	PRINT("WARNING...INVEN doesn't work properly."&'15&'12);
	IERRFG ← FALSE
    END;
GDRKEN
END "GINVEN";

INTERNAL PROCEDURE GDOT(REAL X,Y; INTEGER THK(0));
BEGIN "GDOT"
COMMENT Do a dot;
INTEGER XP,YP;			COMMENT Pixel position of dot;
IF TERRFG AND (THK≠0) THEN
    BEGIN
	PRINT("WARNING...Thickness on graphics doesn't work properly."&'15&'12);
	TERRFG ← FALSE
    END;
COMMENT Don't plot an out-of-range dot.;
YP ← YPIX(Y); XP ← XPIX(X);
IF (XP≥0) AND (XP≤511) AND (YP≥0) AND (XP≤511) THEN GRNDOT(XP,YP,'377)
END "GDOT";

INTERNAL PROCEDURE GLINE(REAL X1,Y1,X2,Y2; INTEGER THK(0));
BEGIN "GLINE"
COMMENT Draw a line on the Grinnell.;
SIMPLE PROCEDURE DRAWIT(REFERENCE REAL X1,Y1,X2,Y2);
  BEGIN INTEGER IX1,IY1,IX2,IY2;
	IX1 ← X1*511 + 0.5; IX2 ← X2*511 + 0.5;
	IY1 ← Y1*479 + 0.5; IY2 ← Y2*479 + 0.5; comment hardware change...;
	GRNLINE(IX1,IY1,IX2,IY2,'377)
  END;

IF TERRFG AND (THK≠0) THEN
    BEGIN
	PRINT("WARNING...Thickness on graphics doesn't work properly."&'15&'12);
	TERRFG ← FALSE
    END;

COMMENT Find normalized device coordinates.;
X1 ← (X1-XL)/(XH-XL); X2 ← (X2-XL)/(XH-XL);
Y1 ← (Y1-YL)/(YH-YL); Y2 ← (Y2-YL)/(YH-YL);

COMMENT If vector mode is not set, set it.;
IF (WRITEMODE LAND BITV) = 0 THEN
    BEGIN
	WRITEMODE ← WRITEMODE LOR BITV;
	GRNINS(LWM LOR WRITEMODE)
    END;

COMMENT Then clip and draw the line.;
CLIP2DNORM(DRAWIT,X1,Y1,X2,Y2)
END "GLINE";

INTERNAL PROCEDURE GRECTA(REAL X1,Y1,X2,Y2);
BEGIN "GRECTA"
COMMENT Draw a rectangle bounded by the two corners.;
INTEGER XP1,YP1,XP2,YP2;

XP1 ← XPIX(X1); XP2 ← XPIX(X2);
YP1 ← YPIX(Y1); YP2 ← YPIX(Y2);

COMMENT Clip to screen boundaries.;
COMMENT This code doesn't work if the screen is in the middle of the rectangle,
	someone should fix it some day;
IF (XOUT(XP1) AND XOUT(XP2)) OR (YOUT(YP1) AND YOUT(YP2)) THEN RETURN;
XLIMIT(XP1); XLIMIT(XP2); YLIMIT(YP1); YLIMIT(YP2);

COMMENT Set up Ea, Eb to small x, size;
IF XP2 > XP1 THEN
    BEGIN
	GRNINS(LEA LOR XP1); GRNINS(LEB LOR (XP2-XP1))
    END
ELSE
    BEGIN
	GRNINS(LEA LOR XP2); GRNINS(LEB LOR (XP1-XP2))
    END;

COMMENT And La, Lb to small y, size;
IF YP2 > YP1 THEN
    BEGIN
	GRNINS(LLA LOR YP1); GRNINS(LLB LOR (YP2-YP1))
    END
ELSE
    BEGIN
	GRNINS(LLA LOR XP1); GRNINS(LLB LOR (YP1-YP2))
    END;

COMMENT If rectilinear mode is not set, set it.;
IF (WRITEMODE LAND BITV) ≠ 0 THEN
    BEGIN
	WRITEMODE ← WRITEMODE LAND (LNOT BITV);
	GRNINS(LWM LOR WRITEMODE)
    END;

COMMENT And now actually draw the rectangle.;
GRNINS(EGW)
END "GRECTA";

INTERNAL PROCEDURE GELLIP(REAL X1,Y1,X2,Y2);
BEGIN "GELLIP"
COMMENT Draw the ellipse which is surrounded by the given box.;

INTEGER L,R;			COMMENT Pixel coords. of one line.;
INTEGER YLINE;			COMMENT Used to clip ellipse to screen.;
INTEGER XC,YC;			COMMENT Pixel coords. of center of ellipse.;
INTEGER X,Y;			COMMENT Pixel values of offsets from center.;
INTEGER A,B;			COMMENT Ellipse half-height and half-width:
					these appear in the equation
					(x/a)↑2 + (y/b)↑2 = 1;

COMMENT If vector mode is not set, set it.;
IF (WRITEMODE LAND BITV) = 0 THEN
    BEGIN
	WRITEMODE ← WRITEMODE LOR BITV;
	GRNINS(LWM LOR WRITEMODE)
    END;

XC ← XPIX((X1+X2)/2); YC ← YPIX((Y1+Y2)/2);
A ← XC - XPIX(X1); B ← YC - YPIX(Y1);

FOR Y ← 0 STEP (IF B>0 THEN 1 ELSE -1) UNTIL B DO
    BEGIN
	COMMENT Solve ellipse equation for x.;
	X ← SQRT(A*A*(1-Y*Y/(B*B)));
	L ← XC-X; R ← XC+X;
	IF NOT(XOUT(L) AND XOUT(R)) THEN
	    BEGIN
		XLIMIT(L);
		XLIMIT(R);
		FOR YLINE ← YC+Y,YC-Y DO
		    IF NOT YOUT(YLINE) THEN
			GRNLINE(L,YLINE,R,YLINE,'377)
	    END
    END

END "GELLIP";
INTERNAL PROCEDURE GPOLY(INTEGER N; REFERENCE REAL X,Y);
  BEGIN "GPOLY"
    INTEGER i, XLOC, YLOC;
    INTEGER ARRAY PTS[1:N,1:2];

    XLOC ← LOCATION(X);
    YLOC ← LOCATION(Y);

    FOR i ← 1 STEP 1 UNTIL N DO BEGIN
	PTS[i,1] ← XPIX(MEMORY[XLOC + I - 1,REAL]);
	PTS[i,2] ← YPIX(MEMORY[YLOC + I - 1,REAL]);
    END;
    GRNPOLY(PTS,N);
  END "GPOLY";
INTERNAL PROCEDURE GPOLYX(INTEGER N; REFERENCE REAL X,Y);
  BEGIN GPOLY(N,X,Y); END;
INTERNAL PROCEDURE GTXTPS(REAL X,Y,XS,YS,DXS(0),DYS(0));
  BEGIN "GTXTPS"
    XPOS ← XPIX(X);
    YPOS ← YPIX(Y);
    IF SERRFG AND (DXS ≠ 0 AND DYS ≠ 0 AND XS ≠ 1 AND YS ≠ 0) THEN BEGIN
	SERRFG ← FALSE;
	PRINT("WARNING...Italics and slant on graphics do not work properly."
		&'15&'12);
    END;
  END "GTXTPS";
INTERNAL PROCEDURE GTEXT(STRING TXT);
  BEGIN "GTEXT"
      INTEGER ARRAY asciiTXT[1:LENGTH(TXT)];
      INTEGER len, I;
      len ← length(TXT);
      FOR I ← 1 STEP 1 UNTIL LEN DO ASCIITXT[I] ← UPPERCASE(TXT[I FOR 1]);
      Comment the Grinnell only has upper case at the momment;
      GRNTXTD(Xpos, ypos, asciiTXT, len);
  END "GTEXT";
INTERNAL PROCEDURE GTEXTD(STRING TXT);
  BEGIN GTEXT(TXT); END;

END "DDSIM"